VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsBuffer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private m_b() As Integer, m_nPtr As Long, m_nMax As Long
Private m_b2() As Integer, m_nPtr2 As Long, m_nCount2 As Long, m_nMax2 As Long 'for inserted string

Private m_nRow As Long, m_nCol As Long, m_nUngetcCount As Long

Friend Property Get LineNumber() As String
LineNumber = "(" + CStr(m_nRow + 1) + "," + CStr(m_nCol + 1) + ")"
End Property

Friend Property Get Pointer() As Long
If m_nMax > 0 Then Pointer = VarPtr(m_b(0))
End Property

Friend Property Get CurrentPosition() As Long
CurrentPosition = m_nPtr
End Property

Friend Sub Clear()
Erase m_b, m_b2
m_nPtr = 0
m_nMax = 0
m_nPtr2 = 0
m_nCount2 = 0
m_nMax2 = 0
m_nRow = 0
m_nCol = 0
m_nUngetcCount = 0
End Sub

Friend Sub SetString(ByRef s As String)
m_nPtr = 0
m_nMax = Len(s)
If m_nMax > 0 Then
 ReDim m_b(m_nMax - 1)
 CopyMemory m_b(0), ByVal StrPtr(s), m_nMax * 2&
Else
 Erase m_b
End If
End Sub

Friend Property Get Data(ByVal nIndex As Long) As Long
Data = m_b(nIndex) And &HFFFF&
End Property

Friend Sub GetString(ByRef s As String)
If m_nPtr > 0 Then
 s = Space(m_nPtr)
 CopyMemory ByVal StrPtr(s), m_b(0), m_nPtr * 2&
Else
 s = vbNullString
End If
End Sub

Friend Sub PutMemoryString(ByVal lp As Long, ByVal m As Long)
Dim i As Long
If m > 0 Then
 i = m_nPtr + m
 If i > m_nMax Then
  m_nMax = i + &H10000
  ReDim Preserve m_b(m_nMax - 1)
 End If
 CopyMemory m_b(m_nPtr), ByVal lp, m * 2&
 m_nPtr = i
End If
End Sub

Friend Sub PutBuffer(ByVal src As clsBuffer)
PutMemoryString src.Pointer, src.CurrentPosition
End Sub

Friend Sub PutString(ByRef s As String)
Dim m As Long
m = Len(s)
If m > 0 Then
 PutMemoryString StrPtr(s), m
End If
End Sub

Friend Sub InsertMemoryString(ByVal lp As Long, ByVal m As Long)
If m > 0 Then
 If m_nCount2 + m > m_nMax2 Then
  m_nMax2 = m_nCount2 + m + &H10000
  ReDim Preserve m_b2(m_nMax2 - 1)
 End If
 If m_nPtr2 < m_nCount2 Then CopyMemory m_b2(m_nPtr2 + m), m_b2(m_nPtr2), (m_nCount2 - m_nPtr2) * 2&
 CopyMemory m_b2(m_nPtr2), ByVal lp, m * 2&
 m_nCount2 = m_nCount2 + m
End If
End Sub

Friend Sub InsertString(ByRef s As String)
Dim m As Long
m = Len(s)
If m > 0 Then
 InsertMemoryString StrPtr(s), m
End If
End Sub

Friend Sub PutChar(ByVal c As Long)
If m_nPtr + 1 > m_nMax Then
 m_nMax = m_nMax + &H10000
 ReDim Preserve m_b(m_nMax - 1)
End If
m_b(m_nPtr) = (c And &H7FFF&) Or (((c And &H8000&) <> 0) And &HFFFF8000)
m_nPtr = m_nPtr + 1
End Sub

Friend Function GetChar() As Long
Dim c As Long
'///read from inserted buffer
If m_nCount2 > 0 Then
 Debug.Assert m_nPtr2 >= 0
 If m_nPtr2 >= 0 And m_nPtr2 < m_nCount2 Then
  GetChar = m_b2(m_nPtr2) And &HFFFF&
  m_nPtr2 = m_nPtr2 + 1
  If m_nUngetcCount > 0 Then m_nUngetcCount = m_nUngetcCount - 1
  Exit Function
 Else
  m_nPtr2 = 0
  m_nCount2 = 0
 End If
End If
'///read from main buffer
Debug.Assert m_nPtr >= 0
If m_nPtr >= 0 And m_nPtr < m_nMax Then
 c = m_b(m_nPtr) And &HFFFF&
 If m_nUngetcCount = 0 Then
  If c = &HA& Then
   m_nRow = m_nRow + 1
   m_nCol = 0
  Else
   m_nCol = m_nCol + 1
  End If
 End If
 GetChar = c
Else
 GetChar = -1
End If
m_nPtr = m_nPtr + 1
If m_nUngetcCount > 0 Then m_nUngetcCount = m_nUngetcCount - 1
End Function

Friend Sub Ungetc(Optional ByVal nCount As Long = 1)
m_nUngetcCount = m_nUngetcCount + nCount
If m_nCount2 > 0 Then
 If nCount <= m_nPtr2 Then
  m_nPtr2 = m_nPtr2 - nCount
  Exit Sub
 Else
  'ungetc too many times!!! currently unsupported!!
  Debug.Assert False
  nCount = nCount - m_nPtr2
  m_nPtr2 = 0
  m_nCount2 = 0
 End If
End If
m_nPtr = m_nPtr - nCount
Debug.Assert m_nPtr >= 0
End Sub

Friend Function EOF() As Boolean
EOF = m_nPtr >= m_nMax
End Function
